home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 24 / CU Amiga Magazine's Super CD-ROM 24 (1998)(EMAP Images)(GB)(Track 1 of 2)[!][issue 1998-07].iso / CUCD / Programming / SWI / source / lib / emacs_interface.pl < prev    next >
Encoding:
Text File  |  1994-11-22  |  6.8 KB  |  266 lines
  1. /*  $Id: emacs_interface.pl,v 1.5 1994/11/22 15:10:24 jan Exp $
  2.  
  3.     Copyright (c) 1991 Jan Wielemaker. All rights reserved.
  4.     jan@swi.psy.uva.nl
  5.  
  6.     Purpose: Quintus editor interface support
  7. */
  8.  
  9. :- module(emacs_interface,
  10.       [ '$editor_load_code'/2
  11.       , find_predicate1/2
  12.       , emacs_consult/1
  13.       , emacs_dabbrev_atom/1
  14.       , emacs_complete_atom/1
  15.       , emacs_previous_command/0
  16.       , emacs_next_command/0
  17.       , call_emacs/1
  18.       , call_emacs/2
  19.       , running_under_emacs_interface/0
  20.       ]).
  21.  
  22.  
  23.         /********************************
  24.         *              UTIL        *
  25.         ********************************/
  26.  
  27. running_under_emacs_interface :-
  28.     emacs_tmp_file(_).
  29.  
  30. emacs_tmp_file(File) :-
  31.     '$argv'(Argv),
  32.     tmp_file(Argv, File).
  33.  
  34. tmp_file(['+C', Raw|_], File) :- !,
  35.     concat('Emacs:', File, Raw).
  36. tmp_file([_|T], File) :-
  37.     tmp_file(T, File).
  38.  
  39.  
  40.         /********************************
  41.         *            SETUP        *
  42.         ********************************/
  43.  
  44. :- (   running_under_emacs_interface
  45.    ->  '$set_prompt'('a%m%l%! ?- ')
  46.    ;   true
  47.    ).
  48.  
  49.  
  50.         /********************************
  51.         *           CONSULT        *
  52.         ********************************/
  53.  
  54. %    '$editor_load_code'(+Kind, +File)
  55. %    Load code from EMACS.  `Kind' is {procedure,region,buffer}.  
  56. %    `File' is the name of the file from which the code comes.  It
  57. %    is an absolute filename.
  58. %    
  59. %    To be implemented.  There is a start for portions of a file
  60. %    (region, procedure), but this is hard:  What is the starting
  61. %    line of the region (for error-messages).  There is also a
  62. %    problem with path-names: `File' is emacs notion of the absolute
  63. %    filename.  SWI-Prologs notion may be different due to symbolic
  64. %    links.  Finally: the region might be the entire file, in which
  65. %    case we need to know about the module info ...`
  66. %
  67. %    (MA)   
  68. %    For the time being:
  69. %    "buffer" loads the entire file associated with the buffer.
  70. %    "predicate" and "region" load the tmp-file. Yes, module info is
  71. %    scrambled...      
  72.    
  73.  
  74.  
  75. '$editor_load_code'(buffer, File) :- !,
  76.     consult(File).
  77. '$editor_load_code'(_Kind, _File) :-
  78.     emacs_tmp_file(TmpFile),
  79.     consult(TmpFile).
  80.  
  81.         /********************************
  82.         *    TELL EMACS ABOUT ERRORS    *
  83.         ********************************/
  84.  
  85. %    Redefine [] to clear the compilation-buffer first
  86.  
  87. :- (   running_under_emacs_interface
  88.    ->  user:redefine_system_predicate([_|_]),
  89.        user:redefine_system_predicate(make),
  90.        user:(module_transparent '.'/2),
  91.        user:assert(([H|T] :- emacs_consult([H|T]))),
  92.        user:assert((make :- emacs_interface:emacs_make)),
  93.        user:assert(exception(A,B,C) :- emacs_interface:exception(A,B,C))
  94.    ;   true
  95.    ).
  96.  
  97.  
  98. :- dynamic
  99.     compilation_base_dir/1.
  100.  
  101. :- module_transparent
  102.     emacs_consult/1.
  103.  
  104. emacs_consult(Files) :-
  105.     emacs_start_compilation,
  106.     consult(Files),
  107.     emacs_finish_compilation.
  108.  
  109.  
  110. emacs_make :-
  111.     emacs_start_compilation,
  112.     system:make,
  113.     emacs_finish_compilation.
  114.     
  115.  
  116. exception(warning, warning(Path, Line, Message), _) :-
  117.     emacs_warning_file(Path, File),
  118.     call_emacs('(prolog-compilation-warning "~w" "~d" "~w")',
  119.            [File, Line, Message]),
  120.     fail.                      % give normal message too
  121.  
  122.  
  123. emacs_start_compilation :-
  124.     absolute_file_name('', Pwd),    
  125.     asserta(compilation_base_dir(Pwd)),
  126.     call_emacs('(prolog-compilation-start "~w")', [Pwd]).
  127.  
  128.     
  129. emacs_finish_compilation :-
  130.     retractall(emacs_compilation_base_dir(_)),
  131.     call_emacs('(prolog-compilation-finish)').
  132.  
  133.  
  134. emacs_warning_file(user, _) :- !,
  135.     fail.                      % donot give warnings here
  136. emacs_warning_file(Path, File) :-
  137.     compilation_base_dir(Cwd),
  138.     concat(Cwd, File, Path), !.
  139. emacs_warning_file(Path, Path).
  140.     
  141.  
  142.  
  143.         /********************************
  144.         *         FIND PREDICATE    *
  145.         ********************************/
  146.  
  147. %    find_predicate1(Name, Arity)
  148. %
  149.  
  150. find_predicate1(Name, Arity) :-
  151.     find_predicate(Name, Arity, Preds),
  152.     (   Preds == []
  153.     ->  call_emacs('(@find "undefined" "nodebug")')
  154.     ;   forall(member(Head, Preds),
  155.            ( source_file(Head, File1)
  156.            , remove_double_slashes(File1, File)
  157.            , call_emacs('(@fd-in "\"~w\" ~w ~w")', [Name, Arity, File])
  158.            ))
  159.     ->  call_emacs('(@find "ok" "nodebug")')
  160.     ;   call_emacs('(@find "none" "nodebug")')
  161.     ).
  162.  
  163. remove_double_slashes(Atom, Atom1) :-
  164.     name(Atom, L),
  165.     remove_double_slashes_list(L, L1),
  166.     name(Atom1, L1).
  167.  
  168. remove_double_slashes_list([], []).
  169. remove_double_slashes_list([0'/, 0'/|T], L) :- !,
  170.     remove_double_slashes_list([0'/|T], L).
  171. remove_double_slashes_list([H|T], [H|T1]) :-
  172.     remove_double_slashes_list(T, T1).
  173.     
  174.  
  175. find_predicate(Name, Arity, Preds) :-
  176.     (   integer(Arity)
  177.     ->  functor(Head, Name, Arity)
  178.     ;   true
  179.     ),
  180.     findall(Pred, find_predicate_(Head, Pred), Preds).
  181.  
  182. find_predicate_(Head, Module:Head) :-
  183.     current_predicate(_, Module:Head),
  184.     \+ predicate_property(Module:Head, imported_from(_)).
  185.     
  186.  
  187.         /********************************
  188.         *          ATOM DABREV        *
  189.         ********************************/
  190.  
  191. emacs_dabbrev_atom(Sofar) :-
  192.     '$complete_atom'(Sofar, Extended, Unique), !,
  193.     map_unique_to_lisp(Unique, LispBool),
  194.     call_emacs('(prolog-complete-atom-with "~s" ~w)',
  195.            [Extended, LispBool]).
  196. emacs_dabbrev_atom(Sofar) :-
  197.     call_emacs('(prolog-completion-error-message (concat "No completions for: " "~s"))', [Sofar]).
  198.  
  199. map_unique_to_lisp(unique, t).
  200. map_unique_to_lisp(not_unique, nil).
  201.  
  202.  
  203.         /********************************
  204.         *         ATOM COMPLETION    *
  205.         ********************************/
  206.  
  207. emacs_complete_atom(Sofar) :-
  208.     '$atom_completions'(Sofar, List), List \== [], !,
  209.     call_emacs('(prolog-completions-start-collect)'),
  210.     emacs_transfer_completions(List, 1),
  211.     call_emacs('(prolog-completions-run "~s")', [Sofar]).
  212. emacs_complete_atom(Sofar) :-
  213.     call_emacs('(prolog-completion-error-message (concat "No completions for: " "~s"))', [Sofar]).
  214.  
  215. emacs_transfer_completions([], _).
  216. emacs_transfer_completions([Atom|T], N) :-
  217.     call_emacs('(prolog-transfer-completion "~w" ~d)', [Atom, N]),
  218.     NN is N + 1,
  219.     emacs_transfer_completions(T, NN).
  220.  
  221.  
  222.         /********************************
  223.         *             HISTORY        *
  224.         ********************************/
  225.  
  226. emacs_insert_command(Nr) :-
  227.     recorded('$history_list', Nr/Command), !,
  228.     flag(emacs_shown_command, _, Nr),
  229.     call_emacs('(prolog-insert-history-command "~w")', Command).
  230. emacs_insert_command(_) :-
  231.     call_emacs('(prolog-completion-error-message "No more commands")').
  232.  
  233. emacs_previous_command :-
  234.     flag('$last_event', Last, Last),
  235.     (   flag(emacs_last_command, Last, Last)
  236.     ->  flag(emacs_shown_command, Shown, Shown),
  237.         This is Shown - 1,
  238.         emacs_insert_command(This)
  239.     ;   flag(emacs_last_command, _, Last),
  240.         emacs_insert_command(Last)
  241.     ).
  242.         
  243.  
  244. emacs_next_command :-
  245.     flag('$last_event', Last, Last),
  246.     (   flag(emacs_last_command, Last, Last)
  247.     ->  flag(emacs_shown_command, Shown, Shown),
  248.         This is Shown + 1,
  249.         emacs_insert_command(This)
  250.     ;   flag(emacs_last_command, _, Last),
  251.         emacs_insert_command(Last)
  252.     ).
  253.  
  254.  
  255.         /********************************
  256.         *           CALL EMACS        *
  257.         ********************************/
  258.  
  259. call_emacs(Fmt) :-
  260.     call_emacs(Fmt, []).
  261. call_emacs(Fmt, Args) :-
  262.     concat_atom(['', Fmt, ''], F1),
  263.     format(F1, Args),
  264.     flush.
  265.  
  266.